home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / Net / DummyInetd.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  2.7 KB  |  144 lines
  1.  
  2. package Net::DummyInetd;
  3.  
  4. require 5.002;
  5.  
  6. use IO::Handle;
  7. use IO::Socket;
  8. use strict;
  9. use vars qw($VERSION);
  10. use Carp;
  11.  
  12. $VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  13.  
  14.  
  15. sub _process
  16. {
  17.  my $listen = shift;
  18.  my @cmd = @_;
  19.  my $vec = '';
  20.  my $r;
  21.  
  22.  vec($vec,fileno($listen),1) = 1;
  23.  
  24.  while(select($r=$vec,undef,undef,undef))
  25.   {
  26.    my $sock = $listen->accept;
  27.    my $pid;
  28.  
  29.    if($pid = fork())
  30.     {
  31.      sleep 1;
  32.      close($sock);
  33.     }
  34.    elsif(defined $pid)
  35.     {
  36.      my $x =  IO::Handle->new_from_fd($sock,"r");
  37.      open(STDIN,"<&=".fileno($x)) || die "$! $@";
  38.      close($x);
  39.  
  40.      my $y = IO::Handle->new_from_fd($sock,"w");
  41.      open(STDOUT,">&=".fileno($y)) || die "$! $@";
  42.      close($y);
  43.  
  44.      close($sock);
  45.      exec(@cmd) || carp "$! $@";
  46.     }
  47.    else
  48.     {
  49.      close($sock);
  50.      carp $!;
  51.     }
  52.   }
  53.  exit -1; 
  54. }
  55.  
  56. sub new
  57. {
  58.  my $self = shift;
  59.  my $type = ref($self) || $self;
  60.  
  61.  my $listen = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
  62.  my $pid;
  63.  
  64.  return bless [ $listen->sockport, $pid ]
  65.     if($pid = fork());
  66.  
  67.  _process($listen,@_);
  68. }
  69.  
  70. sub port
  71. {
  72.  my $self = shift;
  73.  $self->[0];
  74. }
  75.  
  76. sub DESTROY
  77. {
  78.  my $self = shift;
  79.  kill 9, $self->[1];
  80. }
  81.  
  82. 1;
  83.  
  84. __END__
  85.  
  86. =head1 NAME
  87.  
  88. Net::DummyInetd - A dummy Inetd server
  89.  
  90. =head1 SYNOPSIS
  91.  
  92.     use Net::DummyInetd;
  93.     use Net::SMTP;
  94.     
  95.     $inetd = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs);
  96.     
  97.     $smtp  = Net::SMTP->new('localhost', Port => $inetd->port);
  98.  
  99. =head1 DESCRIPTION
  100.  
  101. C<Net::DummyInetd> is just what it's name says, it is a dummy inetd server.
  102. Creation of a C<Net::DummyInetd> will cause a child process to be spawned off
  103. which will listen to a socket. When a connection arrives on this socket
  104. the specified command is fork'd and exec'd with STDIN and STDOUT file
  105. descriptors duplicated to the new socket.
  106.  
  107. This package was added as an example of how to use C<Net::SMTP> to connect
  108. to a C<sendmail> process, which is not the default, via SIDIN and STDOUT.
  109. A C<Net::Inetd> package will be available in the next release of C<libnet>
  110.  
  111. =head1 CONSTRUCTOR
  112.  
  113. =over 4
  114.  
  115. =item new ( CMD )
  116.  
  117. Creates a new object and spawns a child process which listens to a socket.
  118. C<CMD> is a list, which will be passed to C<exec> when a new process needs
  119. to be created.
  120.  
  121. =back
  122.  
  123. =head1 METHODS
  124.  
  125. =over 4
  126.  
  127. =item port
  128.  
  129. Returns the port number on which the I<DummyInetd> object is listening
  130.  
  131. =back
  132.  
  133. =head1 AUTHOR
  134.  
  135. Graham Barr <gbarr@ti.com>
  136.  
  137. =head1 COPYRIGHT
  138.  
  139. Copyright (c) 1995-1997 Graham Barr. All rights reserved.
  140. This program is free software; you can redistribute it and/or modify
  141. it under the same terms as Perl itself.
  142.  
  143. =cut
  144.